perm filename TREST.F4[MSS,LCS]1 blob
sn#092566 filedate 1974-03-21 generic text, type T, neo UTF8
00100 SUBROUTINE TAIL(RJX,RA,RMINI)
00200 COMMON /STF/RSTFAC(8),RSTJC
00300 COMMON /PLTR/IPLT,RHT,DIS
00400 DIMENSION JARY(1),ITAIL(21)
00500 CC IF(JARY(1).EQ.0)CALL RDDATA('TAIL',JARY,ITAIL)
00600 CC R=ABS(RA)
00725 DATA ITAIL/9,100000040, 20036, 80030,100026,120019,120016,110012
00740 1,90007 ,12, 12, 40, 20036, 80030, 100026, 120019, 120016
00785 1,100022, 80025, 60028, 33/
00799 Q=-1.
00800 IF(RA)Q=1.
00900 CALL CENTER(RJY)
01000 CALL JDRAW(ITAIL(1),RJX,RJY,RMINI,1.,Q)
01100 1 IF(IPLT.GE.0)RETURN
01200 IF(RMINI.NE.RSTJC)Q=Q*.6
01300 CALL FILLER(ITAIL(10),RJX,RJY,ABS(Q),Q)
01400 CC IF(IPLT)CALL FILLER(ITAIL(ITAIL(1)+2),RJX,RJY,1.,RQ)
01500 C RA=-,STEM UP; RA=+, STEM DOWN.
01600 END
01700
01800 SUBROUTINE REST
01900 COMMON /STF/RSTFAC(8),RSTJC
02000 COMMON /PLTR/IPLT,RHT,DIS
02100 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
02200 EQUIVALENCE(JE,JQ(3))
02300 DIMENSION LRST(4),IRST(74)
02400
02500 IF(LRST(1).EQ.0)CALL RDDATA('REST',LRST,IRST)
02600 L=JE
02700 IF(L.GT.1)L=1
02800 K=LRST(L+3)
02900 C L>3 WHEN SEVERAL TAILS ON REST
03000 CALL CENTER(CENTR)
03100 CALL JDRAW(IRST(K),RJB,CENTR,RSTJC,1.,1.)
03200 IF(JE.OR.IPLT.GE.0)RETURN
03300 CALL FILLER(IRST(IRST(K)+K+1),RJB,CENTR,1.,1.)
03400 C WHY GO THROUGH NOTWRT??
03500 END
03600
03700 SUBROUTINE RDDATA(NM,JARY,IARY)
03800 C READS DATA
03900 DIMENSION JARY(1),IARY(1)
04000 REWIND 23
04100 CALL IFILE(23,NM)
04200 READ(23,5)K,(JARY(K),K=1,10)
04300 N=1
04400 1 READ(23,5,END=2)K,L,(IARY(K),K=N,N+L-1)
04500 N=N+L
04600 GO TO 1
04700 2 RETURN
04800 5 FORMAT(12I)
04900 END
05000
05100 C FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
05200 SUBROUTINE BREP(RJB,RSTJC)
05300 DIMENSION JREP(1),IREP(35)
05325 DATA IREP/35,100000016,280043,290043, 10016, 20016, 300043,310043
05340 1,30016, 40016, 320043,100020037, 30038, 40038, 50037
05355 1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
05370 1,100270022,280021,290021,300022,300023,290024,280024,270023
05385 1,270022, 300022, 270023, 290023/
05400 CC IF(JREP(1).EQ.0)CALL RDDATA('BREP',JREP,IREP)
05500 CALL CENTER(R)
05600 CALL JDRAW(IREP,RJB,R,RSTJC,1.,1.)
05700 END
05800
05900 SUBROUTINE FERMTA(RINV)
06000 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
06100 COMMON /PLTR/IPLT,RHT,DIS
06200 COMMON /STF/RSTFAC(8),RSTJC
06300 DIMENSION JFERM(1),IFERM(39)
06400 IF(JFERM(1).EQ.0)CALL RDDATA('FERM',JFERM,IFERM)
06500 CC R=INV
06600 CALL JDRAW(IFERM,RJB,CENTR,RSTJC,1.,RINV)
06700 IF(IPLT)CALL FILLER(IFERM(IFERM(1)+2),RJB,CENTR,1.,RINV)
06800 END
06900
07000 SUBROUTINE EXCH(X,Y)
07100 Z=X
07200 X=Y
07300 Y=Z
07400 END
07500 SUBROUTINE SORT2(RPOS,M)
07600 DIMENSION RPOS(2,200)
07700 L=2
07800 3 J=-1
07900 RX=RPOS(1,L-1)
08000 DO 2 K=L,M
08100 IF(RPOS(1,K).GE.RX)GO TO 2
08200 RX=RPOS(1,K)
08300 C WHY WERE ALL THE RX'S JX ????? 9/6/73
08400 J=K
08500 2 CONTINUE
08600 IF(J)GO TO 4
08700 K=L-1
08800 CALL EXCH(RPOS(1,K),RPOS(1,J))
08900 CALL EXCH(RPOS(2,K),RPOS(2,J))
09000 4 L=L+1
09100 IF(L.LE.M)GO TO 3
09200 END
09300